home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops ƒ / zModules < prev    next >
Text File  |  1999-01-26  |  27KB  |  1,150 lines
  1. (*
  2. This file implements relocatable modules.  In installed applications on
  3. the 68k, these became separate code segments, but on the PPC they're
  4. just rolled into the app.  In the development environment, however,
  5. they're the same as on the 68k except that they have a separate
  6. data area (of course), and we keep them locked all the time.  This is
  7. because it's tricky to ensure we only unlock them when it's safe,
  8. especially with the code generator doing method calls doing ?unholdMod.
  9. Also, we really ought to have plenty of memory in the development
  10. environment.
  11.  
  12. Modules live in separate files, and when needed, they're loaded into
  13. two handles (code and data areas).
  14.  
  15. The management of modules is rolled into class Module - each module
  16. we define gets a Module object which lives in the dictionary, and
  17. handles the housekeeping details related to the module files.
  18.  
  19.  
  20. Here's the module file format:
  21.  
  22. Header:
  23.     (offs 0 )    4 bytes        date/time compiled
  24.     (offs 4 )    4 bytes        DirID of source file
  25.     (offs 8 )    4 bytes        self-relative offset to exports table
  26.                             (which follows the code)
  27.     (offs 12)    4 bytes        code size
  28.     (offs 16)    4 bytes        self-relative offset to data start
  29.     (offs 20)    4 bytes        data size
  30.  
  31. Code section
  32.  
  33. Exports table:
  34.     (offs 0 )    4 bytes        offset from header start to first cfa
  35.     (offs 4 )    4 bytes        offset to next cfa
  36.     ...
  37.     (offs n )    4 bytes        -1        marker for end of exports table
  38.  
  39. Data section
  40.  
  41.  
  42. Here's the format of an imported word:
  43.     n bytes        header
  44.     2 bytes        handler code $BD2E
  45.     2 bytes        export table offset for this word
  46.     4 bytes        reloc addr of module object
  47.  
  48. A call to an exported word pushes the xt of the word, then calls
  49. enterMod, which grabs the module addr and export table offset, then
  50. calls the module.
  51. *)
  52.  
  53.  
  54. true    value    CLEANMOD?
  55. false    value    RELEASED?
  56.     0    value    THIS_MOD
  57.     0    value    LAST_MOD
  58.  
  59.     0    value    svCDP
  60.     0    value    svDP
  61.     0    value    svLatest
  62.  
  63.     0    value    start_CDP
  64.     0    value    start_DP
  65.  
  66.     string    $EXP
  67.     string    $CXT
  68.     string    $TMP
  69.     
  70.     file    mod_file
  71.     
  72. forward  LDFROMMOD
  73.  
  74. \ variable    SAVE_CONTEXT    8 4 *  allot
  75.  
  76. (*
  77. : UNEVAL    \ Puts things back to normal after an EVAL"
  78.     evSvDP  0EXIT        \ Out if we're not compiling an eval"
  79.     evSvLatest -> latest
  80.     evSvDP -> DP  0 -> evSvDP
  81.     nil?: $evCxt  NIF  ptr: $evCxt  context  32 cmove  release: $evCxt  THEN
  82. ;
  83. *)
  84.  
  85. : UNMOD            \ Puts things back to normal after a module
  86.                 \ or stand-alone code compilation or eval"
  87. \    unEval
  88.     svCDP  0EXIT        \ Out if we're not compiling a module/SA
  89.     svLatest -> latest
  90.     svCDP -> CDP  svDP -> DP
  91.     0 -> svCDP  0 -> svDP  0 -> compMod
  92.     nil?: $cxt  NIF  ptr: $cxt  context  32  cmove  release: $cxt  THEN
  93.     false -> SAcomp?
  94. ;
  95.  
  96. : >NXTEXP    \ ( cfa -- )  Adds the next cfa offset to the string $exp
  97.             \  which will become the exports table.
  98.     start_CDP -  pad !  pad 4  add: $exp  ;
  99.  
  100.  
  101.  
  102. (*    COMPIMP  ( ^mod -- )  compiles the dic entry for an imported word,
  103.     as defined in the construct
  104.     FROM <modName> IMPORT{ name0 name1 ... }
  105.     ^mod is the data address of the module object.
  106.     For name0, say, we compile a header, then a 2-byte self-relative
  107.     offset back to the module object itself, then a 2-byte field
  108.     which is initially zero, but gets filled in when we compile the
  109.     module, and set to the offset within the module's export table
  110.     for the entry for name0.
  111. *)
  112.  
  113. : COMPIMP  { ^mod -- }
  114.     header
  115.     $ BD2E codeW,            \ handler code for imported_h
  116.     0 codeW,                \ space for export table offset 
  117.     ^mod relocCode,            \ ptr to module
  118. ;
  119.  
  120.  
  121. \ Note: MLOCAL is still (29-7-97) not working properly, so I'll
  122. \  make these into Values, temporarily:
  123.  
  124. 0    value    thisImp
  125. 0    value    thisCfa
  126. \ 0    value    maddr
  127.  
  128.  
  129. :class    MODULE    super{ object }
  130.  
  131. record
  132. {    handle    modHdl
  133.     uint    SEG#
  134.     byte    FLAGS
  135.     int        RES#
  136.     int        #IMP
  137.     dicaddr    LASTIMP
  138.     var        DicDateTime
  139.     int        RELOFFS
  140.     bool    INSTALL?
  141. }
  142.  
  143. :m PRINT:
  144.     ." modHdl    "     get: modHdl  dup nilH =
  145.     IF        drop ." (not loaded)"
  146.     ELSE    .h  ." -> "  ptr: modHdl .h
  147.     THEN  cr
  148.     ." seg#      "  print: seg#        cr
  149.     ." flags     "  print: flags    cr
  150.     ." install?  "  print: install?    cr
  151. ;m
  152.  
  153. :m BASE:
  154.     nil?: modHdl  IF  0  EXIT  THEN
  155.     nptr: modHdl  ;m
  156.  
  157. :m HANDLE:    get: modHdl  ;m
  158.  
  159. :m EXEC_CNT:    99  ;m            \ not used on PPC
  160.  
  161. :m SETRELEASE:    \ ( addr -- )
  162.     modcode -  put: relOffs  ;m
  163.  
  164. :m SETRESID:    \ ( resID -- )
  165.     put: res#  ;m
  166.  
  167. :m INSTALL?:    get: install?  ;m
  168.  
  169. :m SETINSTALL:  { instl? \ ^ST -- }
  170.     instl?  put: install?
  171.     get: seg# segTable_entry  -> ^ST
  172.     instl? 1 and
  173.     dup  1 ^ST creplace  1 ^ST 8 + creplace
  174. ;m
  175.  
  176.  
  177. \ KLUDGE: and UNKLUDGE: may be used when we save a dic image, to mark
  178. \ a module as unloaded in the saved image without really unloading it.
  179.  
  180. \ :m KLUDGE:    \ ( -- modHdl flags exec+locked? )
  181. \    get: modHdl  get: flags  addr: exec_cnt  w@  nilH  put: modHdl  ;m
  182.  
  183. \ :m UNKLUDGE:    \ ( modHdl flags exec+locked? -- )
  184. \    addr: exec_cnt  w!  put: flags  put: modHdl  ;m
  185.  
  186. :m EXTNAME:  { xaddr xlen \ len -- addr' len' }
  187.     getName: self  -> len   pad len cmove
  188.     xaddr  pad len +  xlen  cmove        \ Add extension
  189.     pad  len xlen +  ;m
  190.  
  191. :m BINNAME:    \ ( -- addr len )  Returns name of binary file for module.
  192.     " .PBIN" extName: self  ;m
  193.  
  194. :m TXTNAME:    \ ( -- addr len )  Returns name of text file for module.
  195.     " .TXT" extName: self  ;m
  196.  
  197.  
  198. :m LOAD:  { \ rc modstart ^ST -- }        \ Loads if not loaded already
  199.     instld?                            \ if installed, mods are always loaded
  200.     IF
  201.         get: seg# segTable_entry   -> ^ST
  202.         ^ST 4+ @  nilP =  IF $ dead  db THEN
  203.         EXIT
  204.     THEN
  205.  
  206.     nil?: modHdl  0EXIT
  207.  
  208. \    get: res#
  209. \    IF    'type CODE  get: res#  getRes  dup 0= ?error 138
  210. \        put: modHdl
  211. \    ELSE
  212.         binName: self  name: mod_file  0 setVref: mod_file
  213.         openReadOnly: mod_file  ?error 138
  214.     \    ['] pause 4+ @  0 -> pause        \ Disable pause over read to avoid
  215.     \                                    \  possible reentrancy
  216.         size: mod_file  dup  new: modHdl
  217.         lock: modHdl                    \ Maybe we need this
  218.         ptr: modHdl  swap  read: mod_file  -> rc
  219.     \    ['] pause 4+ !                    \ Restore pause
  220.         unlock: modHdl                    \ Unlock before error check
  221.         close: mod_file  drop  rc ?error 141
  222.         base: self @  get: dicDateTime  u<
  223.         IF                                \ BIN file is old version
  224.             release: modHdl  148 die
  225.         THEN
  226. \    THEN
  227.     moveHi: modHdl                        \ Move module hi since it gets locked
  228.     lock: modHdl
  229.     
  230. \ now we update the ST entries for the code and data segments:
  231.  
  232.     nptr: modHdl  -> modstart
  233.     get: seg# segTable_entry   -> ^ST
  234.     modstart                        \ code start
  235.     ^ST 4+ !
  236.     modstart 12 + @                    \ code size
  237.     ^ST @ $ FF000000 and or
  238.     ^ST !
  239.     modstart 16 + dup @ +            \ data start
  240.     ^ST 12 + !
  241.     modstart 20 + @                    \ data size
  242.     ^ST 8 + @ $ FF000000 and or
  243.     ^ST 8 + !
  244.  
  245. \ now we must fix the icache:
  246.     modstart dup 12 + @  fix_caches
  247. ;m
  248.  
  249.  
  250. :m LOAD_FOR_EXECUTION:  ( -- ptr )
  251.     instld?                            \ if installed, mods are always loaded
  252.     IF
  253.         get: seg#  segTable_entry  4+ @
  254.         dup nilP =  IF $ beef  db THEN  EXIT
  255.     THEN
  256.  
  257.     nil?: modHdl  IF  load: self  THEN
  258.     ptr: modHdl
  259. ;m
  260.  
  261. :m FINISHED_EXECUTION:
  262. ;m
  263.  
  264.  
  265. :m RELEASE:  { \ svModcode -- }
  266.     instld?  ?EXIT
  267.     release: modHdl
  268.     get: seg#  make_seg_absent
  269. ;m
  270.  
  271.  
  272. (*
  273. KEEP: and DROP: flag this module as needed and not needed, respectively.
  274. The main purpose of this flagging is that if GETSPACE is called, loaded
  275. modules will be released to make room, unless they have been flagged as
  276. needed by KEEP:.  But note that RELEASE: ignores the flag, so that we
  277. can get rid of a module by force if necessary.  This may happen if there
  278. was a crash while the module was executing.
  279.  
  280. LOCK: is more drastic than KEEP:, since it means that this module becomes
  281. non-relocatable.  UNLOCK: reverses a LOCK:.  Note that DROP: in effect does
  282. an UNLOCK: as well.
  283.  
  284. This "locking" feature is used for ExtrasMod, which has a window, and
  285. for the debugger and printMod, which can be entered through the back
  286. door (via a vect or a trap).  (By the way, we hope we won't have to do this
  287. back door business anywhere else.  Entering a module through the back door
  288. is not usually a very safe thing to do.)
  289.  
  290. Locking a module can give a useful performance improvement if a module is to
  291. be called several times in succession, since we bypass the _HLock and _Hunlock
  292. calls if the module is marked locked.
  293. *)
  294.  
  295. :m KEEP:
  296.     2  addr: flags  cset  ;m
  297.  
  298. :m DROP:
  299. \    get: exec_cnt NIF  unlock: modHdl  THEN      \ Unlock if not executing
  300.     2  addr: flags creset  ;m
  301.  
  302. :m LOCK:
  303.     load: self
  304. ;m
  305.  
  306. :m UNLOCK:
  307. \    false  put: locked?
  308. \    get: exec_cnt NIF  nil?: modHdl NIF  unlock: modHdl  THEN THEN
  309. ;m
  310.  
  311. :m KEEP?:
  312.     get: flags  ;m
  313.  
  314. :m LOCKED?:
  315.     true  ;m
  316.  
  317.  
  318. :m ?RELEASE:
  319. \    keep?: self  ?EXIT
  320. \    release: self
  321. ;m
  322.  
  323. :m #IMP:    get: #imp  ;m
  324.  
  325. :m getMarkerName:    \ ( -- )  gets the marker name for the this
  326.                     \  module into the string $tmp.  We use this
  327.                     \  marker to temporarily forget the part of the
  328.                     \  dic above the module declaration, so we can
  329.                     \  compile the module in that environment.
  330.     " m__" put: $tmp
  331.     getName: self  add: $tmp
  332. ;m
  333.  
  334.  
  335. :m GETIMPORTS:  { \ n -- }
  336.     0 -> n
  337.     BEGIN
  338.         ^base compimp  1 ++> n
  339.         & }  endlist?
  340.     UNTIL
  341.     n  put: #imp
  342.     latest  name>  put: lastimp
  343.     getMarkerName: self  begin: $tmp
  344.     " marker " insert: $tmp
  345.     all: $tmp  evaluate        \ "marker m__<module name>"
  346.     release: $tmp
  347. ;m
  348.  
  349.  
  350. \                ===================================
  351. \                        Module compilation
  352. \                ===================================
  353.  
  354. private
  355.  
  356. :m ExpSupers:  { ^nw \ relocAddr -- }
  357.     BEGIN
  358.         ^nw @ -> relocAddr
  359.         relocAddr  0EXIT
  360.         relocAddr 24 >>
  361.         get: seg# =                \ look at reloc addr seg#
  362.         IF                        \ we haven't gone out-of-segment yet, so this
  363.                                 \  superclass is in the module, and has to
  364.                                 \  be included.
  365.             ^nw @abs 2+            \ get to start of methods area in class info
  366.             8 FOR                \ go through the 8 method threads
  367.                 dup displace  i expMethods: [self]
  368.                 4+
  369.             NEXT  drop
  370.         THEN
  371.         4 ++> ^nw
  372.     AGAIN  ;m
  373.  
  374. public
  375.             \ This gets called via a late bind, so must be public
  376.  
  377. :m ExpMethods:  { maddr thread# -- }
  378.     BEGIN                \ Loop thru methods in this class
  379.         maddr @ 0>=
  380.         IF                \ We've come to the superclasses - we only
  381.                         \  have to handle these once, of course - and
  382.                         \  since the order in the export table is
  383.                         \  immaterial, we'll just do it if we're on
  384.                         \  thread zero.
  385.             thread#
  386.             NIF  maddr  expSupers: self
  387.             THEN  EXIT
  388.         THEN
  389.                     \ Next method
  390.         maddr 14 +  ( cfa of method )  >nxtExp
  391.         maddr 4+ displace  -> maddr
  392.     AGAIN  ;m
  393.  
  394. private
  395.  
  396. \ &&&&&&&  MLOCAL not working yet - defer to next version
  397.  
  398. \ mlocal !exports: { \ thisImp thisCfa maddr -- }
  399.  
  400. :m ?!class:    \ If this exported item is a class, we set the handler
  401.             \ code of the imported version and add the method entry offsets
  402.             \ to the export table.
  403.  
  404.     thisCfa 2- w@ $ BC1D =  0EXIT    \ Out if it isn't a class
  405.     $ BC2D  thisImp 2- w!            \ set handler of imported word
  406.     2  thisCfa ffa 1+ cset
  407.     thisCfa 2+                \ get to start of methods area in class info
  408.     8 FOR                    \ go through the 8 method threads
  409.         dup displace  i expMethods: self
  410.         4+
  411.     NEXT  drop  ;m
  412.  
  413.  
  414. :m 1export:
  415.     next: theMark  link> -> thisImp
  416.     thisImp  >name n>count  sFind  NIF 999 die  THEN
  417.     -> thisCfa
  418.     thisCfa thisImp =
  419.     IF                                        \ Not defined
  420.         cr thisImp .id  2 spaces  144 die
  421.                                     \ "You forgot to define this exported name"
  422.         false -> cleanMod?
  423.     ELSE                            \ All OK. Put info into import definition:
  424.         thisCfa >name c@  thisImp >name c!    \ Name flags
  425.         pos: $exp  thisImp w!                \ Export table offset
  426.         thisCfa >nxtExp                        \ Add next exp tbl entry
  427.         ?!class: self                        \ More stuff if it's a class
  428.     THEN  ;m
  429.  
  430.  
  431. \ :mloc !exports:        \ { \ n thisImp thisCfa maddr -- }
  432. :m !exports:
  433.     get: #imp  0= ?error 143            \ Module has no exported names
  434.     clear: $exp
  435.     get: lastimp  set: theMark
  436.     get: #imp  FOR  1export: self  NEXT
  437.     -1 pad !  pad 4 add: $exp            \ marker at end of table
  438. \ ;mloc
  439. ;m
  440.  
  441.  
  442. (*
  443. FixLinks: fixes up the dictionary links within the compiled module.  We may
  444. want to find words in the module at run time via FIND, but the problem is that
  445. dic links are relative, not relocatable.  This makes FIND fast, but leads
  446. to a problem at run time when the the module is disconnected from the main
  447. dictionary.  If we didn't do anything, we wouldn't know where to start
  448. searching from, and if the search failed, the last link would point into
  449. outer space.
  450. So what we do is to add a snapshot of CONTEXT to the end of the module to give
  451. a place to start from, and to clear the lowest link on each thread to zero (which
  452. means the end).
  453. *)
  454.  
  455. :m FixLinks:  { \ link prevLink -- }
  456.     #threads FOR
  457.         context  i cells +  -> link
  458.         BEGIN
  459.             link -> prevLink
  460.             link displace -> link
  461.             link start_CDP u<
  462.         UNTIL
  463.         0 prevLink !
  464.     NEXT
  465. $ c0c0c0c0 code,
  466.     CDP 4+ context -  code,        \ adjustment value for context copy
  467.     context 32  codeN,            \ add copy of Context to end of code area
  468. ;m
  469.  
  470. :m GoodCompile:  { \ code_size data_size -- }
  471.     CDP  start_CDP 8 +  displ!            \ store export table offs in header
  472.     all: $exp  codeN,
  473.                                         \ add export table to end
  474.     fixLinks: self                        \ fix dic links in module
  475.  
  476.     CDP start_CDP -  -> code_size        \ size of code (including export table)
  477.     DP  start_DP  -  -> data_size        \ size of data
  478.     code_size  start_CDP 12 + !            \ store code size in header
  479.     
  480.     start_CDP code_size +                \ where data will start
  481.     start_CDP 16 + displ!                \ add offs to data start
  482.     data_size  start_CDP 20 + !            \ and data size
  483.  
  484.     binName: self  name: mod_file            \ Set name of binary file
  485.     create: mod_file  ?error 139
  486.     'type PBIN  'type Mopp  set: mod_file        \ type and signature
  487.     start_CDP  code_size  write: mod_file        \ write out code, leave err code
  488.     start_DP   data_size  write: mod_file or    \ write out data, 'or' err code
  489.     close: mod_file  drop
  490.     IF    msg# 140                        \ I/O error on writing bin file
  491.     ELSE
  492.         curs?  -curs
  493.         cr  getName: mod_file type  ."  saved" cr
  494.         -> curs?
  495.     THEN
  496. ;m
  497.  
  498. public
  499.  
  500. :m COMPILE:  ( -- )
  501.     compMod  ?error 177                    \ Error if already compiling a module
  502.     release: self                        \ Get rid of old version, if loaded
  503.     context 32  put: $cxt                \ save CONTEXT and other things, since
  504.     CDP -> svCDP  DP -> svDP            \  we're going to do a temporary forget
  505.     latest -> svLatest
  506.     ^base -> compMod
  507.     getMarkerName: self
  508.     all: $tmp  evaluate                    \ execute the marker, forgetting back to just
  509.     release: $tmp                        \  after the module declaration
  510.     
  511.     svCDP -> CDP  svDP -> DP
  512.  
  513.     true -> cleanMod?
  514.     pushNew: loadFile
  515.     txtName: self  name: topFile
  516.     CDP -> start_CDP  DP -> start_DP
  517.     24  code_reserve            \ Reserve space for header and offset to exports table.
  518.     ^base -> this_mod
  519.  
  520.     get: seg#  -> comp_seg#
  521.     start_CDP  start_DP  get: seg#  ldFromMod
  522.     0 -> comp_seg#
  523.  
  524.     dateTime  start_CDP !                \ Put compiled date in bin module header
  525.     getDirID: topFile  start_CDP 4+ !    \ Also DirID of source file
  526.     drop: loadfile
  527.     0 -> this_mod
  528.     !exports: self
  529.     cleanMod?
  530.     IF    goodCompile: self            \ Everything's OK.  Do final housekeeping
  531.     THEN
  532.     unmod                            \ Also releases $cxt
  533.     release: $exp  ;m
  534.  
  535.  
  536. \ FIND: works like FIND, but just searches for a word in this module.
  537.  
  538. :m FIND: { s255 \ thrdOffs modCxt cxtOffs -- cfa T | -- s255 F }
  539.     load: self
  540.     s255                                    \ leave on stack for (find)
  541.     dup c@ 7 and 4*  -> thrdOffs            \ like what THREAD does
  542.     ptr: modHdl  dup 12 + @ +  32 -  -> modCxt
  543.     modCxt 4- @  -> cxtOffs
  544.     modCxt thrdOffs +  displace
  545.     dup NIF            \ thread is empty
  546.         drop false  EXIT
  547.     THEN
  548.     cxtOffs -
  549.     ( s255 1st-link )  (find)
  550. ;m
  551.  
  552. :m CLASSINIT:
  553.     -1  put: relOffs
  554.     dateTime put: dicDateTime
  555.     get_free_seg_pair   put: seg#  drop
  556. ;m
  557.  
  558. ;class
  559.  
  560.  
  561. (*
  562. ENTERMOD ( xt -- )  calls a word in a module.  The passed-in xt is of
  563. the IMPORTED word (i.e. probably in the main dictionary).
  564.  
  565. Here's the format of an imported word:
  566.     n bytes        header
  567.     2 bytes        handler code $BD2E
  568.     2 bytes        export table offset for this word
  569.     4 bytes        reloc addr of module object
  570.  
  571. We arrive at imported_h in cg6 when a call to an imported word has
  572. to be compiled.  We there compile a push of the xt of the word, then
  573. a call to enterMod, which does the main work.  We put enterMod here 
  574. in zModules, since it has to do a late-bound call to the module
  575. object, and this is much easier if it's not in the target
  576. compilation, and is also quicker to debug.
  577. *)
  578.  
  579. : (loadMod)  { xt \ xt' ^mod modstart EToffs -- xt' ^mod modstart }
  580.  
  581.     xt 2+ @abs -> ^mod            \ get addr of module
  582.     xt w@x  -> EToffs            \ and export table offset
  583.     ^mod load_for_execution: class_as> module
  584.     -> modstart
  585.     modstart 8 + dup @ +        \ addr of export table
  586.     EToffs + @                    \ module-relative offs to word's xt
  587.     modstart +  -> xt'            \ xt of word in module
  588.     xt' ^mod modstart
  589. ;
  590.  
  591.  
  592. :f ENTERMOD  { xt \ xt' ^mod modstart svMC svMD svMS moddata_start -- }
  593.  
  594.     xt (loadmod)  -> modstart  -> ^mod  -> xt'
  595.  
  596.     modCode -> svMC  modData -> svMD  mod_seg# -> svMS
  597.     ^mod 4+ w@   -> mod_seg#
  598.  
  599.     modstart 16 + dup @ +            \ data start
  600.     -> moddata_start
  601.     
  602.     modstart half_displ_range +  -> modcode
  603.     moddata_start half_displ_range +  -> moddata
  604.  
  605. \ now we actually call the word in the module
  606.     xt' execute
  607.  
  608. \ now we restore everything:
  609.     svMC -> modcode  svMD -> moddata  svMS -> mod_seg#
  610.     ^mod  finished_execution: class_as> module 
  611. ;f
  612.  
  613.  
  614. :f (meth_in_mod)  { ^obj xt modstart seg# \ svMC svMD svMS moddata_start -- }
  615.  
  616.     modCode -> svMC  modData -> svMD   mod_seg# -> svMS
  617.  
  618.     seg# -> mod_seg#
  619.  
  620.     modstart 16 + dup @ +            \ data start
  621.     -> moddata_start
  622.     
  623.     modstart half_displ_range +  -> modcode
  624.     moddata_start half_displ_range +  -> moddata
  625.  
  626. \ now we actually call the method in the module
  627.     ^obj -> rY  xt execute
  628.  
  629. \ now we restore everything:
  630.     svMC -> modcode  svMD -> moddata  svMS -> mod_seg#
  631. ;f
  632.  
  633.  
  634. :f enter_meth_in_mod  { ^obj ^mod EToffs \ xt modstart -- }
  635.  
  636.     ^mod load_for_execution: class_as> module
  637.     -> modstart
  638.     modstart 8 + dup @ +        \ addr of export table
  639.     EToffs + @                    \ module-relative offs to word's xt
  640.     modstart +  -> xt            \ xt of method in module
  641.     
  642.     ^obj xt modstart  ^mod 4+ w@  (meth_in_mod)
  643.  
  644.     ^mod  finished_execution: class_as> module 
  645. ;f
  646.  
  647.  
  648. :f holdMod  { xt \ xt' -- xt' }
  649.     xt (loadmod)  -> heldModStart  -> heldMod  -> xt'
  650.     xt'
  651. ;f
  652.  
  653.  
  654. \ :f unHoldMod
  655. \    0 -> heldMod
  656. \ ;f
  657.  
  658.  
  659. :f LDFROMMOD { code_start data_start seg#
  660.     \ svMC svMD svCS ^ST svModcode_comp_start svModdata_comp_start -- }
  661.  
  662.         \ Load from a module.  We save and restore the current
  663.         \ base address values, in case the load changes them.
  664.         \ We also come here when compiling a module.
  665.  
  666.     modcode -> svMC  moddata -> svMD  \ comp_seg# -> svCS
  667.     modcode_comp_start -> svModcode_comp_start
  668.     moddata_comp_start -> svModdata_comp_start
  669.  
  670.     code_start half_displ_range +  -> modcode
  671.     data_start half_displ_range +  -> moddata
  672.     
  673.     code_start -> modcode_comp_start
  674.     data_start -> moddata_comp_start
  675. \    seg#  -> comp_seg#
  676.     
  677.     seg# segTable_entry  -> ^ST
  678.     code_limit CDP -
  679.     ^ST @ $ FF000000 and or  ^ST !            \ dummy max code length
  680.     code_start  ^ST 4+ !
  681.     data_limit DP -
  682.     ^ST 8 + @ $ FF000000 and or  ^ST 8 + !    \ dummy max data length
  683.     data_start  ^ST 12 + !
  684.  
  685.     loadtop
  686.  
  687.     svMC -> modcode  svMD -> moddata  \ svCS -> comp_seg#
  688.     svmodcode_comp_start -> modcode_comp_start    
  689.     svmoddata_comp_start -> moddata_comp_start
  690. ;f
  691.  
  692.  
  693. : SETRELEASE    \ ( addr -- )
  694.     setRelease: [ this_mod ]  ;
  695.  
  696. \ : MLD
  697. \    dup  load: []  ;
  698.  
  699. \ ' mld -> modLoad
  700.  
  701. :f MOD?        \ ( cfa -- cfa b )
  702.     dup 2- w@  $ BC0B =  NIF  false  EXIT  THEN        \ out if not an object
  703.     dup >obj >classXt  ['] module  =  ;f
  704.  
  705.  
  706. : ?DISP  { theCfa size -- }        \ handler to release selected modules
  707.     theCfa mod?  NIF  drop  EXIT  THEN
  708.     free size <            \ Do we still need space?
  709.     IF    >obj  ?release: module
  710.     ELSE    drop
  711.     THEN  ;
  712.  
  713.  
  714. \ PURGE forcibly releases all modules, no matter what.  I'm not sure
  715. \  this isn't obsolete.
  716.  
  717. : (PRG)  { theCfa size -- }    \ unlock and release
  718.     theCfa mod? NIF  drop  EXIT  THEN
  719.     >obj release: class_as> module  ;
  720.  
  721. : PURGE    ['] (prg)  big#  trav  ;
  722.  
  723.  
  724. : NEEDSPACE    \ ( #bytes -- ) release modules until #bytes are available
  725.     false -> released?
  726.     freeblk drop  ['] ?disp swap trav  ;
  727.  
  728. : GS    big# needSpace  released?  ;
  729.  
  730. ' gs -> getSpace
  731.  
  732.  
  733. : FROM        \ ( -- ^mod sec# )
  734.     module                            \ Create module object
  735.     latest name> >obj  dup -> last_mod  28  ;
  736.  
  737.  
  738. : IMPORT{    \ ( ^mod sec# -- )
  739.     28 ?pairs  getImports: []
  740. ;
  741.  
  742. : EXPORTS_CLASS
  743.     last_mod  exports_class: []
  744. ;
  745.  
  746.  
  747.  
  748. testing?
  749. [IF]
  750.  
  751. : QQ    ." The right QQ!" cr  ;
  752.  
  753. from TESTMOD  import{ AA BB CC DD export_class }
  754.  
  755. : QQ    ." This is the wrong QQ!!!"  ;        \ This one shouldn't!
  756.  
  757. compile: testmod
  758.  
  759. from TESTMOD2  import{ EE }
  760. compile: testmod2
  761.  
  762. +echo
  763.  
  764. export_class EEE
  765.  
  766.  
  767. : h mword hash 0 mfa_offset ;
  768.  
  769. : LOOKFOR    Mword  find: testmod  ;
  770.  
  771. \ endload                \ when testing the early stuff, we bail out here
  772.  
  773. [THEN]
  774.  
  775.  
  776. \ Now that's done, the next thing we need to do is set up our HFS file
  777. \ access:
  778.  
  779. from PATHSMOD    import{  OWP  GETPATHS  .PATHS  }
  780.  
  781. :f OPEN_WITH_PATHS    OWP  ;f
  782.  
  783. compile: pathsMod
  784.  
  785. true -> use_paths?
  786. " mops.paths"  getPaths
  787.  
  788.  
  789. \ Right, we now have HFS paths, so we can access our source files in
  790. \ different folders.
  791.  
  792. from CALL1&LMOD    import{  CallFirst  CallLast  (GET)  (C1)  (CL)  }
  793.  
  794. ' (get) -> get1st&last
  795. ' (C1)  -> doCall1st
  796. ' (CL)  -> doCallLast
  797.  
  798. compile: call1&Lmod
  799.  
  800.  
  801. 0    value        CASE_TYPE
  802.  
  803. from zCASEMOD     import{  case[ ]=> ], range]=> range], default=> ]case
  804.                             select[  ]select }
  805. compile: zCaseMod
  806.  
  807. : SELECT{    postpone select[  ;        immediate
  808. : }SELECT    postpone ]select  ;        immediate
  809. : IS{        postpone ]=>      ;        immediate
  810. : }END        postpone [          ;        immediate
  811. : DEFAULT{    postpone ]  postpone default=>  postpone drop  ;    immediate
  812.  
  813.  
  814. (* ****
  815. +echo
  816.  
  817. \ Torture tests for CASE[ etc - something as complicated as that needs
  818. \ a bit of systematic testing...
  819.  
  820. : q
  821.     select[    3 ]=> 23
  822.           [ 2 ]=> 22
  823.           [ 0 ]=> 20
  824.           [ 8 ]=> 28
  825.     default=> 999
  826.     ]select  ;
  827.  
  828. : qq
  829.     case[ 21 ]=> 210
  830.         [ 22 ]=> 220
  831.         [ 80 ], [ 82 ], [ 84 ], [ 86 ]=> 888
  832.         [ 30 40 range]=> 333
  833.         [ 90 ], [ 92 ], [ 170 ]=> -999
  834.         [ 90 ], [ 92 ], [ 100 150 range], [ 170 ]=> -999
  835.         [ 222 ]=>  2220
  836.       default=> 99
  837.      ]case  ;
  838.  
  839.  
  840. : ?CHK
  841.     2dup <>
  842.     IF    cr .h cr .h
  843.         true abort" check FAILED!!!"        \ error if something doesn't
  844.                                             \  give what we expect
  845.     ELSE
  846.         2drop
  847.     THEN
  848. ;
  849.  
  850.  
  851. 21 qq  210 ?chk
  852. 22 qq  220 ?chk
  853. 80 qq  888 ?chk
  854. 84 qq  888 ?chk
  855. 85 qq  99  ?chk  85 ?chk
  856. 35 qq  333 ?chk
  857. 92 qq  -999 ?chk
  858. 120 qq -999 ?chk
  859. 170 qq -999 ?chk
  860. 222 qq 2220 ?chk
  861. 9999 qq 99 ?chk 9999 ?chk
  862.  
  863. 3 q        23    ?chk
  864. 2 q        22    ?chk
  865. 8 q        28    ?chk
  866. 6 q        999    ?chk  6 ?chk
  867. -1 q    999    ?chk  -1 ?chk
  868. 9  q    999    ?chk  9 ?chk
  869.  
  870.  
  871. \ torture tests WORKED!
  872.  
  873. endload
  874.  
  875. ***** *)
  876.  
  877.  
  878. from pasmMod import{    :PPC_code  ;PPC_code
  879.                         disasm  disasm_word  disasm_xt
  880.                         disasm_rng  disasm_cnt  disasm_one
  881.                         set_disasm_call_range  }
  882. compile: pasmMod
  883.  
  884.  
  885. $ 1000    constant    kFloat        \ OR with a #cells parm for an EXTERN
  886.                                 \  to show that the parm is floating
  887.  
  888.  
  889. vtest?
  890. [IF]
  891. \ testing vector assembly:
  892.  
  893. :ppc_code q
  894. (*
  895.     v1        v2        v3        vaddubm,
  896.     v2        v3        v4        vadduhm,
  897.     v3        v4        v5        vadduwm,
  898.     v4        v5        v6        vaddcuw,
  899.     v7        v8        v9        vaddubs,
  900.     v10        v11        v12        vadduhs,
  901.     v13        v14        v15        vadduws,
  902.     v16        v17        v18        vaddsbs,
  903.     v19        v20        v21        vaddshs,
  904.     v22        v23        v24        vaddsws,
  905.  
  906.     v23        v24        v25        vsububm,
  907.     v24        v25        v26        vsubuhm,
  908.     v24        v25        v26        vsubuwm,
  909.     v24        v25        v26        vsubcuw,
  910.     v24        v25        v26        vsububs,
  911.     v24        v25        v26        vsubuhs,
  912.     v24        v25        v26        vsubuws,
  913.     v24        v25        v26        vsubsbs,
  914.     v24        v25        v26        vsubshs,
  915.     v24        v25        v26        vsubsws,
  916.  
  917.     v24        v25        v26        vmaxub,
  918.     v24        v25        v26        vmaxuh,
  919.     v24        v25        v26        vmaxuw,
  920.     v24        v25        v26        vmaxsb,
  921.     v24        v25        v26        vmaxsh,
  922.     v24        v25        v26        vmaxsw,
  923.  
  924.     v24        v25        v26        vminub,
  925.     v24        v25        v26        vminuh,
  926.     v24        v25        v26        vminuw,
  927.     v24        v25        v26        vminsb,
  928.     v24        v25        v26        vminsh,
  929.     v24        v25        v26        vminsw,
  930.  
  931.     v24        v25        v26        vavgub,
  932.     v24        v25        v26        vavguh,
  933.     v24        v25        v26        vavguw,
  934.     v24        v25        v26        vavgsb,
  935.     v24        v25        v26        vavgsh,
  936.     v24        v25        v26        vavgsw,
  937.  
  938.     v24        v25        v26        vrlb,
  939.     v24        v25        v26        vrlh,
  940.     v24        v25        v26        vrlw,
  941.     v24        v25        v26        vslb,
  942.     v24        v25        v26        vslh,
  943.     v24        v25        v26        vslw,
  944.     v24        v25        v26        vsl,
  945.     v24        v25        v26        vsrb,
  946.     v24        v25        v26        vsrh,
  947.     v24        v25        v26        vsrw,
  948.     v24        v25        v26        vsr,
  949.     v24        v25        v26        vsrab,
  950.     v24        v25        v26        vsrah,
  951.     v24        v25        v26        vsraw,
  952.  
  953.     v24        v25        v26        vand,
  954.     v24        v25        v26        vandc,
  955.     v24        v25        v26        vor,
  956.     v24        v25        v26        vxor,
  957.     v24        v25        v26        vnor,
  958.  
  959.     v12                        mfvscr,
  960.     v13                        mtvscr,
  961. *)
  962.     v24        v25        v26        vcmpequb,
  963.     v24        v25        v26        vcmpequh,
  964.     v24        v25        v26        vcmpequw,
  965.     v24        v25        v26        vcmpequfp,
  966.     v24        v25        v26        vcmpgefp,
  967.     v24        v25        v26        vcmpgtub,
  968.     v24        v25        v26        vcmpgtuh,
  969.     v24        v25        v26        vcmpgtuw,
  970.     v24        v25        v26        vcmpgtfp,
  971.     v24        v25        v26        vcmpgtsb,
  972.     v24        v25        v26        vcmpgtsh,
  973.     v24        v25        v26        vcmpgtsw,
  974.     v24        v25        v26        vcmpbfp,
  975.  
  976.     v24        v25        v26        vmuloub,
  977.     v24        v25        v26        vmulouh,
  978.     v24        v25        v26        vmulosb,
  979.     v24        v25        v26        vmulosh,
  980.     v24        v25        v26        vmuleub,
  981.     v24        v25        v26        vmuleuh,
  982.     v24        v25        v26        vmulesb,
  983.     v24        v25        v26        vmulesh,
  984.     v24        v25        v26        vsum4ubs,
  985.     v24        v25        v26        vsum4sbs,
  986.     v24        v25        v26        vsum4shs,
  987.     v24        v25        v26        vsum2sws,
  988.     v24        v25        v26        vsumsws,
  989.  
  990.     v24        v25        v26        vaddfp,
  991.     v24        v25        v26        vsubfp,
  992.  
  993.     v24        v25                vrefp,
  994.     v24        v25                vsqrtefp,
  995.     v24        v25                vexptefp,        \ one of these 2 must have a wrong
  996.     v24        v25                vlogefp,        \  secondary opcode!?!!
  997.     v24        v25                vrfin,
  998.     v24        v25                vrfiz,
  999.     v24        v25                vrfip,
  1000.     v24        v25                vrfim,
  1001.  
  1002.     v24        v25        5        vcfux,
  1003.     v24        v25        5        vcfsx,
  1004.     v24        v25        5        vctusx,
  1005.     v24        v25        5        vctsxs,
  1006.  
  1007.     v13        v12        v11        vmaxfp,
  1008.     v13        v12        v11        vminfp,
  1009.  
  1010.     v13        v12        v11        vmrghb,
  1011.     v13        v12        v11        vmrghh,
  1012.     v13        v12        v11        vmrghw,
  1013.     v13        v12        v11        vmrglb,
  1014.     v13        v12        v11        vmrglh,
  1015.     v13        v12        v11        vmrglw,
  1016.  
  1017.     v13        v12        9        vspltb,
  1018.     v13        v12        9        vsplth,
  1019.     v13        v12        9        vspltw,
  1020.     v13        v12        9        vspltisb,
  1021.     v13        v12        9        vspltish,
  1022.     v13        v12        9        vspltisw,
  1023.  
  1024.     v13        v12        v11        vslo,
  1025.     v13        v12        v11        vsro,
  1026.     v13        v12        v11        vpkuhum,
  1027.     v13        v12        v11        vpkuwum,
  1028.     v13        v12        v11        vpkuhus,
  1029.     v13        v12        v11        vpkuwus,
  1030.     v13        v12        v11        vpkshus,
  1031.     v13        v12        v11        vpkswus,
  1032.     v13        v12        v11        vpkshss,
  1033.     v13        v12        v11        vpkswss,
  1034.  
  1035.     v13        v12                vupkhsb,
  1036.     v13        v12                vupkhsh,
  1037.     v13        v12                vupklsb,
  1038.     v13        v12                vupklsh,
  1039.     v13        v12        v11        vpkpx,
  1040.     v13        v12                vupkhpx,
  1041.     v13        v12                vupklpx,
  1042.  
  1043. \ vector data stream instructions:
  1044.  
  1045.     r6    r7    2                dst,
  1046.     r6    r7    2                dstt,
  1047.     r6    r7    3                dstst,
  1048.     r6    r7    3                dststt,
  1049.             3                dss,
  1050.             3                dssall,
  1051.  
  1052. \ vector loads and stores:
  1053.  
  1054.     v21        r13        r14        lvsl,
  1055.  
  1056. \ I'm omitting the data stream instructions for now, as the manual
  1057. \  is inconsistent and looks like the design was still in flux
  1058. \  when the prelim manual was done!
  1059.  
  1060.     v21        r13        r14        lvebx,
  1061.     v21        r13        r14        lvehx,
  1062.     v21        r13        r14        lvewx,
  1063.     v21        r13        r14        lvx,
  1064.     v21        r13        r14        lvxl,
  1065.     v21        r13        r14        stvebx,
  1066.     v21        r13        r14        stvehx,
  1067.     v21        r13        r14        stvewx,
  1068.     v21        r13        r14        stvx,
  1069.     v21        r13        r14        stvxl,
  1070.  
  1071.                             blr,
  1072.  
  1073. ;ppc_code
  1074.  
  1075. : qq db q ;
  1076.  
  1077. endload
  1078.  
  1079. [THEN]
  1080.  
  1081.  
  1082. from zCALLSMOD  import{  SYSCALL  KONST  $>KONST  }
  1083.  
  1084. compile: zCallsMod
  1085.  
  1086. \ compiling zCallsMod takes a long time, so we'll normally save
  1087. \  the dic at this point.  Therefore we now define a new RUN word.
  1088.  
  1089.  
  1090. : init2            \ our second stage initialization word
  1091.     init1                        \ do the 1st stage initialization
  1092.     0 -> bufPtr  0 -> hiCDP        \ for interpreting message binds
  1093.     instld? NIF  " mops.paths" getPaths  THEN
  1094.             \ add any other special class or module initialization here.
  1095. ;
  1096.  
  1097. ' init2 -> objinit
  1098.  
  1099.  
  1100. : cl2            \ our second stage cleanup word
  1101.     unmod  cl1  ;
  1102.  
  1103. ' cl2  -> abortVec
  1104.  
  1105.  
  1106. :f RUN
  1107. \    init2
  1108.     cr ." This is Mike's interim nucleus."
  1109.     cr ." Type // ppcb.ld" cr
  1110.     QUIT
  1111. ;f
  1112.  
  1113.  
  1114. endload
  1115.  
  1116.  
  1117.  
  1118. \ More testing stuff:
  1119.  
  1120. +echo
  1121.  
  1122.  
  1123. :class    HAHA    super{ int }
  1124.  
  1125. callLast    print:
  1126.  
  1127. :m BAtest:
  1128.     1 2 3 . . .  ;m
  1129. ;class
  1130.  
  1131. :class SUBHAHA  super{ haha }
  1132.  
  1133. callLast    dump:
  1134.  
  1135. :m BAtest:  -9 -8 -7 . . .  ;m
  1136.  
  1137. ;class
  1138.  
  1139. haha    hh
  1140. subhaha    ss
  1141.  
  1142. : q batest: hh  batest: ss  ;
  1143.  
  1144.  
  1145. : QQ    ." QQ here.  Hello. "  ;        \ This gets called from testMod
  1146.  
  1147. variable VB
  1148.  
  1149. compile: testmod2
  1150.